home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / cgwrka10.zip / DEMO.PRG < prev    next >
Text File  |  1994-02-14  |  7KB  |  326 lines

  1. /*****************************************************************
  2. *    Copyright (c). All rights reserved.
  3. *
  4. *    PROGRAM NAME: DEMO
  5. *
  6. *    AUTHOR: BOSTJAN DEBELJAK
  7. *
  8. *    DATE: 29 Feb 94
  9. *
  10. *    DESCRIPTION: demo ,program for library CG_WORK
  11. *
  12. *****************************************************************/
  13.  
  14. #include "inkey.ch"    /* KEY CODE DEFINITIONS    */
  15.  
  16. #define M0             0    /* ~People */
  17. #define M1             1    /* ~Exit */
  18.  
  19. #define M0_0            50    /* ~Person */
  20. #define M0_1            51    /* p~Arent */
  21. #define M0_2            52    /* ~Town */
  22. #define M0_3            53    /* ~Car */
  23.  
  24. #define M1_0           100    /* ~Exit */
  25.  
  26. /**********/
  27.  
  28. #define TM0    "~People"
  29. #define TM1    "~Exit"
  30.  
  31. #define TM0_0    "~Person"
  32. #define TM0_1    "p~Arent"
  33. #define TM0_2    "~Town"
  34. #define TM0_3    "~Car"
  35.  
  36. #define TM1_0    "~Exit"
  37.  
  38. /**********/
  39.  
  40. STATIC hBar, hM0, hM1
  41.  
  42. /********************/
  43.  
  44. FUNCTION Main()
  45.     LOCAL nChoice, cond_work
  46.     PUBLIC ret_person[2]
  47.  
  48.     PUBLIC    db_path
  49.  
  50.    db_path := "."
  51.    SET DATE TO german
  52.  
  53.    cg_init()
  54.  
  55.    CreateBar()
  56.    CLS
  57.  
  58.    BarActivate( hBar )
  59.    nChoice := BarMenuChoice( hBar )
  60.    cond_work := .t.
  61.    DO WHILE cond_work == .t.
  62.     DO CASE
  63.     CASE nChoice == M0_0    /* ~Person    */
  64.         person()
  65.     CASE nChoice == M0_1    /* p~Arent    */
  66.         parent()
  67.     CASE nChoice == M0_2    /* ~Town    */
  68.         town()
  69.     CASE nChoice == M0_3    /* ~Car    */
  70.         car()
  71.     CASE nChoice == M1_0    /* ~Exit    */
  72.         cond_work := .f.
  73.     OTHERWISE
  74.         nChoice := BarMenuChoice( hbar, 1)
  75.     ENDCASE
  76.     if (cond_work == .t.)
  77.         BarActivate( hBar )
  78.         nChoice := BarMenuChoice( hBar )
  79.     endif
  80.    ENDDO
  81.  
  82.    CLS
  83. RETURN NIL
  84.  
  85. /***
  86. *  CreateBar() --> NIL
  87. *  This functions creates the menus, grays certain prompts, checks other
  88. *  prompts
  89. *
  90. */
  91. STATIC FUNCTION CreateBar()
  92.  
  93.    // Create empty bar menu
  94.    hBar := BarNew()
  95.  
  96.    // Create empty menus
  97.     hBar := BarNew()
  98.  
  99.     // Create empty menus
  100.     hM0    := MenuNew( TM0 )
  101.     hM1    := MenuNew( TM1 )
  102.  
  103.     PromptAdd ( hM0, M0_0, TM0_0)
  104.     PromptAdd ( hM0, M0_1, TM0_1)
  105.     PromptAdd ( hM0, M0_2, TM0_2)
  106.     PromptAdd ( hM0, M0_3, TM0_3)
  107.  
  108.     PromptAdd ( hM1, M1_0, TM1_0)
  109.  
  110. /**********/
  111.  
  112.     //Add menus to menubar
  113.     MenuAdd( hBar, hM0 )
  114.     MenuAdd( hBar, hM1 )
  115.  
  116. RETURN NIL
  117.  
  118. /*****************************************************************
  119. *    FUNCTION NAME:
  120. *
  121. *    DESCRIPTION:
  122. *
  123. *****************************************************************/
  124. func car()
  125.  
  126.     cg_work("INP_DEMO", "W_CAR", 25, 5, 70, 14)
  127.  
  128. RETURN NIL
  129.  
  130. /*****************************************************************
  131. *    FUNCTION NAME:
  132. *
  133. *    DESCRIPTION:
  134. *
  135. *****************************************************************/
  136. func parent()
  137.  
  138.     before_query = "set_person"
  139.     COMM_U1 = "F1-Help,F2-Query,F3-Next,F4-Prev,F5-Update,F6-Outp,F8-Exit"
  140.     COMM_U2 = ""
  141.     U_Next := K_F3
  142.     U_Prev := K_F4
  143.     U_Update := K_F5
  144.     U_Output := K_F6
  145.     U_Add := NIL
  146.     U_Delete := NIL
  147.     U_Line := NIL
  148.     U_Num := NIL
  149.     U_Comm := NIL
  150.     before_output = "print_head"
  151.     par_bef_out = "2, PARENT"
  152.     cg_work("INP_DEMO", "W_PARENT", 5, 5, 75, 20)
  153.  
  154. RETURN NIL
  155.  
  156. /*****************************************************************
  157. *    FUNCTION NAME:
  158. *
  159. *    DESCRIPTION:
  160. *
  161. *****************************************************************/
  162. func person()
  163.  
  164.     before_output = "print_head"
  165.     par_bef_out = "1, PERSON"
  166.     u_call_F9 = "show_el_no"
  167.     COMM_U2 := COMM_U2 + ",F9-El_no"
  168.     ret_person = cg_work("INP_DEMO", "W_PERSON", 5, 5, 75, 20)
  169.  
  170. RETURN NIL
  171.  
  172. /*****************************************************************
  173. *    FUNCTION NAME:
  174. *
  175. *    DESCRIPTION:
  176. *
  177. *****************************************************************/
  178. func town()
  179.  
  180.     before_output = "print_head"
  181.     par_bef_out = "3, TOWN"
  182.     cg_work("INP_DEMO", "W_TOWN", 25, 5, 60, 13)
  183.  
  184. RETURN NIL
  185.  
  186. /******************************************************************************/
  187.  
  188. /********************************************************
  189. *  check_car()
  190. *  Real (first car element isn't real car) car can own just one person
  191. *
  192. ********************************************************/
  193. FUNCTION check_car(i, ii)
  194.     local str, cond, line
  195.  
  196.     cond := .t.
  197.     if (ins_val[i] != "0")
  198.         select car
  199.         line := Recno()
  200.         goto 1
  201.         str := "car->id_no = " + CHR(39) + RTRIM(ins_val[i]) + CHR(39)
  202.         locate for &str
  203.         car_id := car->c_ind
  204.         goto line
  205.  
  206.         select people
  207.         line := Recno()
  208.         goto 1
  209.         str := "people->c_ind = " + LTRIM(STR(car_id))
  210.         locate for &str
  211.         if (Found())
  212.             cond := .f.
  213.         endif
  214.         goto line
  215.     endif
  216.  
  217. RETURN cond
  218.  
  219. /********************************************************
  220. *  ins_c()
  221. *  insert other part of car
  222. *
  223. ********************************************************/
  224. FUNCTION ins_c(i)
  225.     local str
  226.  
  227.     if (i == 8)
  228.         str := FieldName(3)    /* TYPE        */
  229.         ins_val[i + 1] := &str
  230.     else
  231.         str := FieldName(2)    /* NUMBER    */
  232.         ins_val[i - 1] := &str
  233.     endif
  234.  
  235. RETURN NIL
  236.  
  237. /********************************************************
  238. *  ins_p()
  239. *  insert other part of name
  240. *
  241. ********************************************************/
  242. FUNCTION ins_p(i)
  243.     local str
  244.  
  245.     if (i == 1 .or. i == 3 .or. i == 5)
  246.         str := FieldName(3)    /* SURNAME    */
  247.         ins_val[i + 1] := &str
  248.     else
  249.         str := FieldName(2)    /* NAME        */
  250.         ins_val[i - 1] := &str
  251.     endif
  252.  
  253. RETURN NIL
  254.  
  255. /********************************************************
  256. *  print_head()
  257. *  print header on output
  258. *
  259. ********************************************************/
  260. FUNCTION print_head(fp, param)
  261.     local str_end, line, str[2]
  262.  
  263.     str := ListAsArray(param)
  264.     line = CHR(K_TAB) + CHR(K_TAB) + "REPORT" + str[1] + ": " + str[2]
  265.     fwrite(fp, line)
  266.     str_end = CHR(K_RETURN) + CHR(10)
  267.     fwrite(fp, str_end)
  268.     fwrite(fp, str_end)
  269.  
  270. RETURN NIL
  271.  
  272. /********************************************************
  273. *  set_person()
  274. *  set person data returned from previous 'cg_work' on submenu PERSON
  275. *
  276. ********************************************************/
  277. FUNCTION set_person()
  278.  
  279.     if (ret_person[1] != NIL)
  280.         ins_val[1] := ret_person[1]
  281.         ins_val[2] := ret_person[2]
  282.     endif
  283.  
  284. RETURN NIL
  285.  
  286. /********************************************************
  287. *  show_el_no()
  288. *  get and display current showed element number
  289. *
  290. ********************************************************/
  291. FUNCTION show_el_no()
  292.     local no, str
  293.  
  294.     no := 1
  295.     while (previous_el() == .t.)
  296.         /* COUNT ELEMENT NUMBER    */
  297.         no++
  298.     end
  299.     str := "Element number is: " + LTRIM(STR(no))
  300.     str := str + SPACE(80 - LEN(str))
  301.     @ Maxrow(), 0 SAY str
  302.     Inkey(5)
  303.     for i:= 1 to no-1
  304.         /* GO ON DISPLAYED ELEMENT    */
  305.         next_el()
  306.     next
  307.  
  308. RETURN NIL
  309.  
  310. /********************************************************
  311. *  val_not_futur()
  312. *  validate (check) inserted date. Date must not be in future
  313. *
  314. ********************************************************/
  315. FUNCTION val_not_futur(i)
  316.     local cond
  317.  
  318.     cond := .t.
  319.     if (LEN(ins_val[i]) != 0)
  320.         if (DATE() < CTOD(ins_val[i]))
  321.             cond := .f.
  322.         endif
  323.     endif
  324.  
  325. RETURN cond
  326.